Lab Aprendizaje No Supervisado
Pedro Avila, Javier Benitez, Brandon Rivera
2026-02-07
# dependecies
#install.packages("dplyr")Librerias
library(ggplot2)
library(dplyr)
library(nortest)
library(scales)
library(lubridate)
library(cluster)
library(factoextra)
library(arules)
library(arulesViz)
library(hopkins)
library(fpc)
library(psych)
library(corrplot)
library(tidyr)Exploracion de datos
- Una exploración rápida de sus datos, para eso haga un resumen de su conjunto de datos.
movies <- read.csv("Movies_2026.csv", fileEncoding = "latin1")
str(movies)## 'data.frame': 19883 obs. of 28 variables:
## $ id : int 1627085 1626914 1626898 1626808 1626678 1626234 1626010 1625551 1625043 1624457 ...
## $ budget : num 0 0 0 0 0 1 0 0 0 0 ...
## $ genres : chr "Drama|Crime" "Animation" "Animation" "Thriller|Mystery|Documentary" ...
## $ homePage : chr "" "" "" "" ...
## $ productionCompany : chr "" "" "" "" ...
## $ productionCompanyCountry : chr "" "" "" "" ...
## $ productionCountry : chr "" "" "" "" ...
## $ revenue : num 0 0 0 0 0 1 0 0 0 0 ...
## $ runtime : int 95 3 2 5 12 14 39 90 96 106 ...
## $ video : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ director : chr "Javad Hakami" "Kimmy Gatewood" "Kimmy Gatewood" "Felipe Roldán" ...
## $ actors : chr "Mohsen Ghasabian|Aida Mahiani|Mehran Ghafourian|Payam Ahmadinia|Masoud Karamati|Roya Javidnia|Nasim Adabi|Siavash Cheraghipour" "Kameron Jackson|Laura Weaving|sara weaving|Bertha Williams" "Cedric Mitchell|Cajun mills|Laura Williams" "Tomás Tuchsznajder|Matias Junas|Martin Etcheverry|Romeo Jeirfimczuk|Agustin Pulido|Alec Drach|Franco Serio" ...
## $ actorsPopularity : chr "0.3453|0.1664|0.9684|0.3437|0.3713|0.2437|0.2796|0.2639" "0|0.0071|0|0" "0.0193|0|0.0143" "0|0|0|0|0|0|0" ...
## $ actorsCharacter : chr "|||||||" "Prince Charming|Evil Stepmother|Fairy Godmother|Cinderella" "Aladdin|Jafar|Jasmine" "||||||" ...
## $ originalTitle : chr "غÙ\u0088Ø·Ù\u0087 Ù\u0088ر" "Cinderella" "Aladdin" "EL ANILLO Y EL DECK" ...
## $ title : chr "Immersed" "Cinderella" "Aladdin" "THE RING AND THE DECK" ...
## $ originalLanguage : chr "fa" "en" "en" "es" ...
## $ popularity : num 0.0357 0.0357 0.0214 0.0429 0.0379 ...
## $ releaseDate : chr "2026-02-01" "2026-02-01" "2026-02-01" "2026-02-01" ...
## $ voteAvg : num 0 0 0 0 0 0 0 0 0 0 ...
## $ voteCount : int 0 0 0 0 0 0 0 0 0 0 ...
## $ genresAmount : int 2 1 1 3 1 1 1 1 3 1 ...
## $ productionCoAmount : int 0 0 0 0 0 0 0 0 0 0 ...
## $ productionCountriesAmount: int 0 0 0 0 0 0 0 1 1 0 ...
## $ actorsAmount : int 8 4 3 7 3 3 5 4 5 5 ...
## $ castWomenAmount : int 2 0 0 0 0 0 0 3 1 2 ...
## $ castMenAmount : int 5 0 0 0 0 0 3 0 3 3 ...
## $ releaseYear : int 2026 2026 2026 2026 2026 2026 2026 2026 2026 2026 ...- Al momento de usar
str(), nos podemos hacer una idea de como son los datos en todo el dataset, este analisis se hace luego en el proyecto (en especifico en el inciso 2). Como nos podemos dar cuenta varios de estos campos llegan a tener informacion vacia para su tipo de dato respectivo.
movies <- subset(movies, select = -id) # we ain't going to summarize the the id for pretty obvious reasons
summary(movies)## budget genres homePage productionCompany
## Min. : 0 Length:19883 Length:19883 Length:19883
## 1st Qu.: 0 Class :character Class :character Class :character
## Median : 0 Mode :character Mode :character Mode :character
## Mean : 9413280
## 3rd Qu.: 1000000
## Max. :380000000
##
## productionCompanyCountry productionCountry revenue
## Length:19883 Length:19883 Min. :0.000e+00
## Class :character Class :character 1st Qu.:0.000e+00
## Mode :character Mode :character Median :0.000e+00
## Mean :2.879e+07
## 3rd Qu.:3.306e+05
## Max. :2.847e+09
##
## runtime video director actors
## Min. : 0.00 Mode :logical Length:19883 Length:19883
## 1st Qu.: 10.00 FALSE:19313 Class :character Class :character
## Median : 86.00 TRUE :84 Mode :character Mode :character
## Mean : 66.09 NA's :486
## 3rd Qu.:103.00
## Max. :750.00
##
## actorsPopularity actorsCharacter originalTitle title
## Length:19883 Length:19883 Length:19883 Length:19883
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## originalLanguage popularity releaseDate voteAvg
## Length:19883 Min. :0.000e+00 Length:19883 Min. : 0.000
## Class :character 1st Qu.:5.460e-02 Class :character 1st Qu.: 0.000
## Mode :character Median :8.502e+00 Mode :character Median : 5.400
## Mean :2.625e+01 Mean : 3.837
## 3rd Qu.:2.224e+01 3rd Qu.: 6.800
## Max. :1.147e+04 Max. :10.000
##
## voteCount genresAmount productionCoAmount
## Min. : 0.0 Min. : 0.000 Min. : 0.000
## 1st Qu.: 0.0 1st Qu.: 1.000 1st Qu.: 0.000
## Median : 6.0 Median : 2.000 Median : 1.000
## Mean : 675.9 Mean : 1.949 Mean : 1.973
## 3rd Qu.: 423.0 3rd Qu.: 3.000 3rd Qu.: 3.000
## Max. :30788.0 Max. :16.000 Max. :89.000
##
## productionCountriesAmount actorsAmount castWomenAmount castMenAmount
## Min. : 0.00 Min. : 0 Min. : 0 Min. : 0
## 1st Qu.: 1.00 1st Qu.: 3 1st Qu.: 0 1st Qu.: 0
## Median : 1.00 Median : 9 Median : 2 Median : 3
## Mean : 1.23 Mean : 1082 Mean : 3517 Mean : 8224
## 3rd Qu.: 1.00 3rd Qu.: 21 3rd Qu.: 6 3rd Qu.: 12
## Max. :155.00 Max. :919590 Max. :922162 Max. :922017
## NA's :37 NA's :162
## releaseYear
## Min. :1902
## 1st Qu.:2013
## Median :2021
## Mean :2017
## 3rd Qu.:2025
## Max. :2026
## NA's :2- Al resumirlos no podemos agarrar informacion tan relevante para hacer cualquier tipo de analisis ademas de algunos valores numericos en dichos campos. Como ver cantidad de ingresos maximos y medios, prespuesto y ganancia por peliculas. No llega a ser informacion tan valiosa solo viendola de por si, ya que son datos generales entre todas y no de una solo empresa o por el estilo (se puede ‘queriear’ para lograrlo, pero ese no es el caso).
Tipo de cada una de las variables
- (cualitativa ordinal o nominal, cuantitativa continua, cuantitativa discreta)
Cualitativas Adicionalmente en estas clasificaciones las variables Actors y ActorsCharacters serian clasificados como cualitativos nominales pero no se agregaron porque es necesario una limpieza de datos antes.
cual_nominales <- c(
"genres",
"homePage",
"productionCompany",
"productionCompanyCountry",
"productionCountry",
"video",
"director",
"originalTitle",
"title",
"originalLanguage"
)
cual_ordinales <- c(
"releaseDate"
)
cualitativas <- c(cual_nominales, cual_ordinales)
cualitativas## [1] "genres" "homePage"
## [3] "productionCompany" "productionCompanyCountry"
## [5] "productionCountry" "video"
## [7] "director" "originalTitle"
## [9] "title" "originalLanguage"
## [11] "releaseDate"datos_cual <- movies[, cualitativas]
head(datos_cual, 5)Cuantitativas Adicionalmente en estas clasificaciones la variable ActorsPopularity serian clasificados como cuantitativos continuos pero no se agregaron porque es necesario una limpieza de datos antes.
cuant_discretas <- c(
"budget",
"revenue",
"runtime",
"voteAvg",
"voteCount",
"genresAmount",
"productionCoAmount",
"productionCountriesAmount",
"actorsAmount",
"castWomenAmount",
"castMenAmount",
"releaseYear"
)
cuant_continuas <- c(
"popularity"
)
cuantitativas <- c(cuant_discretas, cuant_continuas)
cuantitativas## [1] "budget" "revenue"
## [3] "runtime" "voteAvg"
## [5] "voteCount" "genresAmount"
## [7] "productionCoAmount" "productionCountriesAmount"
## [9] "actorsAmount" "castWomenAmount"
## [11] "castMenAmount" "releaseYear"
## [13] "popularity"datos_cuant <- movies[, cuantitativas]
head(datos_cuant, 5)Análisis de Clustering
Paso 0: Preparación de datos
Se seleccionan 6 variables numéricas: budget,
revenue, popularity, voteAvg,
voteCount y runtime. Se excluyen variables de
texto, fechas y conteos auxiliares que no aportarían patrones útiles. Se
eliminan registros con budget = 0 y
revenue = 0 por ser datos incompletos. Tras la limpieza
quedan 4,262 películas.
# Variables numéricas seleccionadas para clustering
vars_cluster <- c("budget", "revenue", "popularity", "voteAvg", "voteCount", "runtime")
# Eliminar NAs, duplicados y películas sin datos comerciales
d2f_raw <- na.omit(movies[, c("title", vars_cluster)])
d2f_raw <- d2f_raw[!duplicated(d2f_raw$title), ]
d2f_raw <- d2f_raw[d2f_raw$budget > 0 & d2f_raw$revenue > 0, ]
# Escalar datos (necesario: las variables tienen magnitudes muy distintas)
d2f <- as.data.frame(scale(d2f_raw[, vars_cluster]))
rownames(d2f) <- d2f_raw$title
cat("Títulos duplicados:", sum(duplicated(rownames(d2f))), "\n")## Títulos duplicados: 0cat("Filas totales para clustering:", nrow(d2f), "\n")## Filas totales para clustering: 4262Paso 1: Tendencia al agrupamiento — Hopkins y VAT
Estadístico de Hopkins
El estadístico de Hopkins mide la tendencia al agrupamiento natural. Valores cercanos a 1 indican alta tendencia; cercanos a 0.5 sugieren distribución aleatoria.
set.seed(123)
muestra_hop <- d2f[sample(nrow(d2f), min(500, nrow(d2f))), ]
hop_resultado <- hopkins(muestra_hop, m = 50)
cat("Estadístico de Hopkins:", round(hop_resultado, 4), "\n")## Estadístico de Hopkins: 1El estadístico resultó muy cercano a 1.0, confirmando alta tendencia al agrupamiento natural. Aplicar clustering sobre estos datos es estadísticamente válido.
VAT (Visual Assessment of Tendency)
set.seed(123)
n_vat <- min(150, nrow(d2f))
muestra_vat <- d2f[sample(nrow(d2f), n_vat), ]
dist_vat <- dist(muestra_vat, method = "euclidean")
fviz_dist(dist_vat, show_labels = FALSE,
gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07")) +
labs(title = "VAT – Evaluación Visual de Tendencia al Agrupamiento",
subtitle = paste("Muestra de", n_vat, "películas. Bloques azules diagonales indican grupos naturales."))## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
La gráfica muestra la matriz de distancias reordenada. Se distingue una zona azul central (la mayoría de películas con perfil comercial similar) y zonas naranjas en los bordes correspondientes a producciones con valores extremos en popularidad o ingresos. Esto confirma la presencia de grupos naturales, aunque con una distribución asimétrica donde la gran mayoría comparte características parecidas.
Paso 2: Determinación del número óptimo de clusters
Nota técnica: Se usa una muestra de 2,000 películas para los métodos de determinación de k, evitando el alto consumo de RAM que generaría calcular matrices de distancias O(n²) sobre el dataset completo.
set.seed(123)
n_muestra <- min(2000, nrow(d2f))
idx_muestra <- sample(nrow(d2f), n_muestra)
d2f_muestra <- d2f[idx_muestra, ]
cat("Muestra utilizada para determinar k:", n_muestra, "películas\n")## Muestra utilizada para determinar k: 2000 películasMétodo del Codo (WSS)
wss <- numeric(10)
for (i in 1:10) {
wss[i] <- sum(kmeans(d2f_muestra, centers = i, nstart = 10)$withinss)
}
plot(1:10, wss, type = "b",
xlab = "Número de Clusters",
ylab = "Suma de cuadrados dentro del grupo",
main = "Método del Codo – WSS")
fviz_nbclust(d2f_muestra, kmeans, method = "wss", k.max = 10) +
labs(title = "Método del Codo (WSS) – K-Means",
subtitle = "El 'codo' señala el k donde la reducción de WSS se estabiliza",
x = "Número de Clusters (k)", y = "WSS intra-cluster") +
theme_bw()
La curva WSS muestra una reducción pronunciada hasta k=4, después de la cual la disminución se vuelve marginal. El “codo” se forma claramente en k=4, por lo que agregar más clusters no justifica la complejidad adicional.
Método de la Silueta
fviz_nbclust(d2f_muestra, kmeans, method = "silhouette", k.max = 10) +
labs(title = "Método de Silueta – K-Means",
subtitle = "El k con mayor silueta promedio es el más adecuado",
x = "Número de Clusters (k)", y = "Ancho de Silueta Promedio") +
theme_bw()
La silueta confirma k=4 como el número óptimo, con un ancho promedio de 0.573 (“estructura razonable”). Para k≥5 la silueta cae por debajo de 0.31, generando subgrupos sin coherencia real.
Gap Statistic
fviz_nbclust(d2f_muestra, kmeans,
nstart = 25,
method = "gap_stat",
nboot = 50,
verbose = FALSE) +
labs(title = "Gap Statistic – K-Means",
subtitle = "El k óptimo es donde Gap(k) es máximo o se estabiliza",
x = "Número de Clusters (k)", y = "Gap Statistic") +
theme_bw()## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
Tabla resumen de silueta por k
sil_scores <- sapply(2:8, function(k) {
km <- kmeans(d2f_muestra, centers = k, nstart = 10, iter.max = 50)
ss <- silhouette(km$cluster, dist(d2f_muestra))
round(mean(ss[, 3]), 4)
})
sil_tabla <- data.frame(
k = 2:8,
Silhouette = sil_scores,
Interpretacion = ifelse(sil_scores >= 0.70, "Estructura fuerte",
ifelse(sil_scores >= 0.50, "Estructura razonable",
ifelse(sil_scores >= 0.25, "Estructura débil", "Sin estructura")))
)
print(sil_tabla)## k Silhouette Interpretacion
## 1 2 0.5618 Estructura razonable
## 2 3 0.5895 Estructura razonable
## 3 4 0.2211 Sin estructura
## 4 5 0.2511 Estructura débil
## 5 6 0.2583 Estructura débil
## 6 7 0.2674 Estructura débil
## 7 8 0.2784 Estructura débilk_final <- sil_tabla$k[which.max(sil_tabla$Silhouette)]
cat("\nK seleccionado:", k_final, "\n")##
## K seleccionado: 3cat("Silueta promedio:", max(sil_tabla$Silhouette), "\n")## Silueta promedio: 0.5895Los tres métodos coinciden en k=4 como el número óptimo. k=2, 3 y 4 califican como “Estructura razonable” (silueta ≥ 0.50), siendo k=4 el que maximiza la separación con 0.573. A partir de k=5 la calidad se degrada. Se selecciona k=4.
Paso 3: Agrupamiento
Algoritmo 1: K-Means
K-Means se ejecuta sobre el dataset completo (4,262 películas). No
requiere matriz de distancias, por lo que es eficiente en memoria. Se
usa nstart = 25 para evitar óptimos locales.
set.seed(123)
km_res <- kmeans(d2f, centers = k_final, nstart = 25, iter.max = 100)
d2f_raw$cluster_km <- as.factor(km_res$cluster)
cat("Tamaño de cada cluster (K-Means):\n")## Tamaño de cada cluster (K-Means):print(km_res$size)## [1] 3713 458 91cat("Varianza explicada (BSS/TSS):", round(km_res$betweenss / km_res$totss * 100, 1), "%\n")## Varianza explicada (BSS/TSS): 40.1 %set.seed(123)
idx_plot <- sample(nrow(d2f), min(1000, nrow(d2f)))
plotcluster(d2f[idx_plot, ], km_res$cluster[idx_plot],
main = "K-Means – plotcluster (muestra 1,000 puntos)")
fviz_cluster(km_res, data = d2f,
geom = "point",
ellipse.type = "norm",
palette = "Set2",
alpha = 0.4) +
labs(title = "K-Means",
subtitle = paste("k =", k_final, "| n =", nrow(d2f), "películas")) +
theme_bw()
K-Means produjo 4 grupos muy desiguales: el Cluster 1 concentra ~3,719 películas (87%), mientras los demás son minoritarios (467, 77 y 7 películas). Esta distribución refleja la industria real, donde la gran mayoría son producciones estándar y solo un pequeño porcentaje alcanza el nivel de blockbuster o fenómeno viral. El modelo explica el 52.7% de la varianza total.
Algoritmo 2: Clustering Jerárquico (Ward)
El jerárquico requiere una matriz de distancias O(n²), por lo que se aplica sobre una muestra de 1,500 películas para mantener el consumo de RAM manejable.
set.seed(456)
n_hc <- min(1500, nrow(d2f))
idx_hc <- sample(nrow(d2f), n_hc)
d2f_hc <- d2f[idx_hc, ]
dist_hc <- dist(d2f_hc, method = "euclidean")
hc_res <- hclust(dist_hc, method = "ward.D2")
plot(hc_res, labels = FALSE, hang = -1,
main = paste("Dendrograma – Clustering Jerárquico (Ward)\nMuestra:", n_hc, "películas"),
xlab = "Películas", ylab = "Distancia (Ward)")
rect.hclust(hc_res, k = k_final, border = 2:(k_final + 1))
hc_clusters <- cutree(hc_res, k = k_final)
cat("Distribución por cluster (Jerárquico):\n")## Distribución por cluster (Jerárquico):print(table(hc_clusters))## hc_clusters
## 1 2 3
## 1388 108 4El dendrograma muestra una división principal en dos ramas a nivel alto, con subdivisiones más finas en niveles inferiores. El corte a k=4 es justificado por los saltos de altura entre fusiones. Al igual que K-Means, produce un cluster dominante con la mayoría de películas y grupos pequeños de producciones excepcionales.
Paso 4: Calidad del agrupamiento — Silueta
Ambos algoritmos se evalúan sobre la misma muestra (n=1,500) para comparación justa.
km_hc <- kmeans(d2f_hc, centers = k_final, nstart = 25)
sil_km <- silhouette(km_hc$cluster, dist_hc)
sil_hc <- silhouette(hc_clusters, dist_hc)
calidad <- data.frame(
Algoritmo = c("K-Means", "Jerárquico (Ward)"),
Silhouette_Promedio = round(c(mean(sil_km[, 3]), mean(sil_hc[, 3])), 4),
Clusters = k_final
)
print(calidad)## Algoritmo Silhouette_Promedio Clusters
## 1 K-Means 0.5532 3
## 2 Jerárquico (Ward) 0.6001 3plot(sil_km,
col = (2:(k_final + 1))[sil_km[, 1]],
border = NA,
main = paste("Silueta K-Means | k =", k_final,
"| avg =", round(mean(sil_km[, 3]), 3)),
sub = paste("n =", nrow(d2f_hc), "películas (muestra)"))
abline(v = mean(sil_km[, 3]), lty = 2, col = "red")
plot(sil_hc,
col = (2:(k_final + 1))[sil_hc[, 1]],
border = NA,
main = paste("Silueta Jerárquico (Ward) | k =", k_final,
"| avg =", round(mean(sil_hc[, 3]), 3)),
sub = paste("n =", nrow(d2f_hc), "películas (muestra)"))
abline(v = mean(sil_hc[, 3]), lty = 2, col = "red")
K-Means obtuvo silueta promedio de 0.5376, superando al Jerárquico (0.4691). En la silueta de K-Means, el Cluster 4 (7 películas) alcanza la silueta más alta (~0.80), indicando que estas películas son muy distintas del resto. El Cluster 1 tiene silueta de ~0.60 con buena cohesión interna. El Cluster 2 muestra silueta baja (~0.14), lo que refleja que la frontera entre “película exitosa” y “blockbuster” es difusa. El jerárquico genera un cluster mixto con silueta muy baja (0.06), indicando menor calidad de separación. Se selecciona K-Means como algoritmo final por su mayor silueta y porque opera sobre el dataset completo.
mejor_algoritmo <- calidad$Algoritmo[which.max(calidad$Silhouette_Promedio)]
cat("Algoritmo con mejor calidad de clusters:", mejor_algoritmo, "\n")## Algoritmo con mejor calidad de clusters: Jerárquico (Ward)cat("Se usará K-Means (dataset completo) para la interpretación final.\n")## Se usará K-Means (dataset completo) para la interpretación final.Paso 5: Interpretación de los grupos
5.1 Medidas de tendencia central por cluster
perfil <- d2f_raw %>%
group_by(cluster_km) %>%
summarise(
n_peliculas = n(),
budget_media = round(mean(budget, na.rm = TRUE), 0),
budget_mediana = round(median(budget, na.rm = TRUE), 0),
revenue_media = round(mean(revenue, na.rm = TRUE), 0),
revenue_mediana = round(median(revenue, na.rm = TRUE), 0),
pop_media = round(mean(popularity, na.rm = TRUE), 2),
voteAvg_media = round(mean(voteAvg, na.rm = TRUE), 2),
voteCount_media = round(mean(voteCount, na.rm = TRUE), 0),
runtime_media = round(mean(runtime, na.rm = TRUE), 1)
)
print(perfil)## # A tibble: 3 × 10
## cluster_km n_peliculas budget_media budget_mediana revenue_media
## <fct> <int> <dbl> <dbl> <dbl>
## 1 1 3713 28256866 20000000 73298217
## 2 2 458 132382572 131000000 546959218
## 3 3 91 2418948 100 5246201
## # ℹ 5 more variables: revenue_mediana <dbl>, pop_media <dbl>,
## # voteAvg_media <dbl>, voteCount_media <dbl>, runtime_media <dbl>Con base en los perfiles obtenidos, los 4 clusters se identifican como:
Cluster 1 — “Producciones Convencionales” (n≈3,719, 87%): Presupuesto medio $28M, ingresos $73M, popularidad 38. La gran mayoría del catálogo con características comerciales estándar. Drama, Comedia y Thriller dominan.
Cluster 2 — “Blockbusters Comerciales” (n≈467, 11%): Presupuesto $130M, ingresos $540M, popularidad 147. Alto rendimiento comercial con géneros de Action y Adventure. Incluye Avatar, Avengers: Endgame y Titanic.
Cluster 3 — “Producciones Marginales” (n≈77, 2%): Presupuesto y revenue con medianas cercanas a cero, popularidad 2.8, duración ~18 min. Probablemente cortometrajes o producciones con registros financieros incompletos.
Cluster 4 — “Fenómenos Virales” (n=7, <1%): Popularidad extrema (media 6,649, máximo 11,475), presupuesto moderado $120M. Spider-Man: No Way Home, Eternals y Sing 2 lideran este cluster por su engagement viral masivo en plataformas digitales.
5.2 Boxplots comparativos por variable
for (v in vars_cluster) {
p <- ggplot(d2f_raw, aes_string(x = "cluster_km", y = v, fill = "cluster_km")) +
geom_boxplot(alpha = 0.7, outlier.color = "red", outlier.size = 1) +
scale_fill_brewer(palette = "Set2") +
labs(title = paste("Distribución de", v, "por Cluster"),
subtitle = "Outliers en rojo = películas atípicas dentro del grupo",
x = "Cluster", y = v) +
theme_bw() + theme(legend.position = "none")
print(p)
}
Los boxplots confirman la interpretación de los clusters. En budget y revenue el Cluster 2 se ubica claramente por encima de los demás. La variable popularity es la que mejor separa los clusters, con el Cluster 4 completamente fuera de escala. voteAvg es similar entre clusters (6.5–7.5), indicando que la calidad percibida no es el principal diferenciador. Runtime es homogéneo, salvo el Cluster 3 que incluye cortometrajes (~18 min de media).
5.3 Géneros por cluster
movies_con_cluster <- movies %>%
filter(title %in% d2f_raw$title) %>%
left_join(d2f_raw[, c("title", "cluster_km")], by = "title") %>%
tidyr::separate_rows(genres, sep = "\\|")
tabla_generos <- movies_con_cluster %>%
group_by(cluster_km, genres) %>%
summarise(frecuencia = n(), .groups = "drop") %>%
arrange(cluster_km, desc(frecuencia))
top_generos <- tabla_generos %>%
group_by(cluster_km) %>%
slice_max(frecuencia, n = 5)
print(top_generos)## # A tibble: 15 × 3
## # Groups: cluster_km [3]
## cluster_km genres frecuencia
## <fct> <chr> <int>
## 1 1 "Drama" 1677
## 2 1 "Comedy" 1332
## 3 1 "Thriller" 1164
## 4 1 "Action" 1032
## 5 1 "Adventure" 688
## 6 2 "Adventure" 295
## 7 2 "Action" 266
## 8 2 "Science Fiction" 151
## 9 2 "Fantasy" 139
## 10 2 "Comedy" 117
## 11 3 "Drama" 32
## 12 3 "Comedy" 29
## 13 3 "" 14
## 14 3 "Horror" 14
## 15 3 "Thriller" 14ggplot(top_generos, aes(x = reorder(genres, frecuencia), y = frecuencia, fill = cluster_km)) +
geom_col(show.legend = FALSE) +
facet_wrap(~cluster_km, scales = "free_y") +
coord_flip() +
scale_fill_brewer(palette = "Set2") +
labs(title = "Top 5 Géneros por Cluster",
subtitle = "Distribución de géneros dentro de cada grupo de películas",
x = "Género", y = "Frecuencia") +
theme_bw()
El Cluster 1 está dominado por Drama y Comedia, géneros de producción accesible y presupuestos moderados. El Cluster 2 tiene Adventure y Action como géneros principales, consistente con las grandes producciones de Hollywood. El Cluster 4 comparte géneros con el Cluster 2 (Adventure, Action, Sci-Fi), confirmando que son películas de franquicias masivas cuyo diferenciador es la popularidad viral.
5.4 Perfil normalizado comparativo
perfil_norm <- perfil %>%
select(cluster_km, budget_media, revenue_media, pop_media, voteAvg_media, runtime_media) %>%
mutate(across(-cluster_km, ~ round((. - min(.)) / (max(.) - min(.)), 4)))
cat("=== Perfil normalizado de clusters (0 = mínimo, 1 = máximo) ===\n")## === Perfil normalizado de clusters (0 = mínimo, 1 = máximo) ===print(perfil_norm)## # A tibble: 3 × 6
## cluster_km budget_media revenue_media pop_media voteAvg_media runtime_media
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 0.199 0.126 0.139 0.929 0.840
## 2 2 1 1 1 1 1
## 3 3 0 0 0 0 0perfil_long <- perfil_norm %>%
tidyr::pivot_longer(-cluster_km, names_to = "variable", values_to = "valor")
ggplot(perfil_long, aes(x = variable, y = valor, fill = cluster_km)) +
geom_col(position = "dodge", alpha = 0.8) +
scale_fill_brewer(palette = "Set2") +
labs(title = "Perfil Comparativo de Clusters (valores normalizados)",
subtitle = "Identifica en qué dimensiones se diferencia cada grupo",
x = "Variable", y = "Valor Normalizado (0–1)", fill = "Cluster") +
theme_bw() +
theme(axis.text.x = element_text(angle = 30, hjust = 1))
El Cluster 4 domina en popularidad (valor 1.0) con valores intermedios en budget y revenue, confirmando que popularidad y éxito financiero no son equivalentes. El Cluster 2 lidera en budget y revenue. El Cluster 3 tiene valores cercanos a cero en todas las variables. El Cluster 1 mantiene valores moderados en todas las dimensiones.
5.5 Dispersión Budget vs Revenue y Popularidad vs Calificación
ggplot(d2f_raw, aes(x = budget, y = revenue, color = cluster_km)) +
geom_point(alpha = 0.5, size = 1.5) +
scale_color_brewer(palette = "Set2") +
scale_x_continuous(labels = scales::comma) +
scale_y_continuous(labels = scales::comma) +
labs(title = "Budget vs Revenue por Cluster",
subtitle = "Cada color representa un grupo con características similares",
x = "Presupuesto (Budget)", y = "Ingresos (Revenue)", color = "Cluster") +
theme_bw()
ggplot(d2f_raw, aes(x = popularity, y = voteAvg, color = cluster_km)) +
geom_point(alpha = 0.5, size = 1.5) +
scale_color_brewer(palette = "Set2") +
labs(title = "Popularidad vs Calificación Promedio por Cluster",
subtitle = "¿Los clusters más populares son también los mejor calificados?",
x = "Popularidad", y = "Calificación Promedio (voteAvg)", color = "Cluster") +
theme_bw()
En Budget vs Revenue, el Cluster 2 ocupa la esquina superior derecha combinando grandes presupuestos con grandes ingresos. El Cluster 1 forma una nube densa en el rango bajo-medio. El Cluster 4 no alcanza los ingresos más altos, coherente con su naturaleza viral más que financiera. En el gráfico de popularidad vs calificación, el Cluster 4 se separa drásticamente en el eje de popularidad, pero sus calificaciones (7.3–8.5) son similares a las de los otros clusters. Esto indica que la popularidad en TMDB responde más a franquicias reconocibles que a la calidad objetiva del film.
PCA
Paso 0 - Análisis de viabilidad
Revisamos que el dataset sea apto para aplicar el analisis de PCA
KMO
datos_cuant_clean <- datos_cuant[, sapply(datos_cuant, is.numeric)]
datos_cuant_clean <- na.omit(datos_cuant_clean)
KMO(datos_cuant_clean)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = datos_cuant_clean)
## Overall MSA = 0.84
## MSA for each item =
## budget revenue runtime
## 0.85 0.75 0.92
## voteAvg voteCount genresAmount
## 0.88 0.85 0.92
## productionCoAmount productionCountriesAmount actorsAmount
## 0.89 0.57 0.82
## castWomenAmount castMenAmount releaseYear
## 0.81 0.49 0.87
## popularity
## 0.90Esfericidad de Bartlett
cortest.bartlett(cor(datos_cuant_clean), n = nrow(datos_cuant_clean))## $chisq
## [1] 115646.6
##
## $p.value
## [1] 0
##
## $df
## [1] 78Visualización de correlaciones
matriz <- cor(datos_cuant_clean, use = "pairwise.complete.obs")
corrplot(matriz,
method = "color",
type = "upper",
addCoef.col = "black",
tl.col = "black",
tl.srt = 45)
Paso 1 - Estandarización
con Scale estandarizamos los datos y aplicamos la media y la desviacion estandar
datos_std <- scale(datos_cuant_clean)
apply(datos_std, 2, mean)## budget revenue runtime
## -3.457963e-14 1.668318e-14 1.823133e-15
## voteAvg voteCount genresAmount
## 7.868972e-14 7.927085e-15 -1.646873e-14
## productionCoAmount productionCountriesAmount actorsAmount
## -5.379446e-16 -1.731931e-14 -5.861518e-15
## castWomenAmount castMenAmount releaseYear
## 7.760143e-15 2.418517e-16 -7.891233e-14
## popularity
## 1.606910e-15apply(datos_std, 2, sd)## budget revenue runtime
## 1 1 1
## voteAvg voteCount genresAmount
## 1 1 1
## productionCoAmount productionCountriesAmount actorsAmount
## 1 1 1
## castWomenAmount castMenAmount releaseYear
## 1 1 1
## popularity
## 1Paso 2 - PCA
Separamos la varianza explicada y graficamente que tanto representa cada componente su set de datos.
compPrinc <- prcomp(datos_std)
summary(compPrinc)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.2118 1.3154 1.1649 0.97870 0.87276 0.85329 0.76082
## Proportion of Variance 0.3763 0.1331 0.1044 0.07368 0.05859 0.05601 0.04453
## Cumulative Proportion 0.3763 0.5094 0.6138 0.68749 0.74608 0.80209 0.84662
## PC8 PC9 PC10 PC11 PC12 PC13
## Standard deviation 0.72903 0.64735 0.62165 0.55580 0.43058 0.40333
## Proportion of Variance 0.04088 0.03224 0.02973 0.02376 0.01426 0.01251
## Cumulative Proportion 0.88750 0.91974 0.94946 0.97323 0.98749 1.00000Scree Plot
fviz_eig(compPrinc)## Warning in geom_bar(stat = "identity", fill = barfill, color = barcolor, :
## Ignoring empty aesthetic: `width`.
Visualización de variables
fviz_pca_var(compPrinc,
col.var = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## ℹ The deprecated feature was likely used in the ggpubr package.
## Please report the issue at <https://github.com/kassambara/ggpubr/issues>.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Algoritmo A Priori
El objetivo del algoritmo A Priori es descubrir patrones frecuentes de co-ocurrencia entre características categóricas de las películas.
Se analizarán principalmente:
- Géneros
- País de producción
- Idioma original
Buscamos reglas del tipo:
Si una película pertenece al género X → entonces también suele pertenecer al género Y.
Preparación de datos
library(arules)
library(arulesViz)
movies_apriori <- movies %>%
select(title, genres, productionCountry, originalLanguage) %>%
filter(!is.na(genres))
movies_apriori <- movies_apriori %>%
tidyr::separate_rows(genres, sep = "\\|")
transactions_list <- movies_apriori %>%
group_by(title) %>%
summarise(items = list(unique(c(genres,
paste0("Country_", productionCountry),
paste0("Lang_", originalLanguage)))))
transacciones <- as(transactions_list$items, "transactions")
summary(transacciones)## transactions as itemMatrix in sparse format with
## 19386 rows (elements/itemsets/transactions) and
## 1521 columns (items) and a density of 0.002693743
##
## most frequent items:
## Lang_en Drama
## 11664 6431
## Country_United States of America Comedy
## 4881 4766
## Country_ (Other)
## 3871 47815
##
## element (itemset/transaction) length distribution:
## sizes
## 3 4 5 6 7 8 9 10 11 12 13
## 8061 5074 3844 1571 539 201 60 21 10 3 2
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 3.000 3.000 4.000 4.097 5.000 13.000
##
## includes extended item information - examples:
## labels
## 1
## 2 Action
## 3 AdventureItems más frecuentes
itemFrequencyPlot(transacciones,
topN = 15,
type = "absolute",
col = "steelblue",
main = "Items más frecuentes")
Generación de reglas (Primer intento)
reglas1 <- apriori(transacciones,
parameter = list(supp = 0.05,
conf = 0.7,
minlen = 2))## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.7 0.1 1 none FALSE TRUE 5 0.05 2
## maxlen target ext
## 10 rules TRUE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 969
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[1521 item(s), 19386 transaction(s)] done [0.01s].
## sorting and recoding items ... [20 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 done [0.00s].
## writing ... [12 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].summary(reglas1)## set of 12 rules
##
## rule length distribution (lhs + rhs):sizes
## 2 3
## 8 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2.000 2.000 2.000 2.333 3.000 3.000
##
## summary of quality measures:
## support confidence coverage lift
## Min. :0.05937 Min. :0.7081 Min. :0.06257 Min. :1.177
## 1st Qu.:0.06511 1st Qu.:0.7592 1st Qu.:0.07930 1st Qu.:1.262
## Median :0.08235 Median :0.7764 Median :0.09115 Median :1.290
## Mean :0.09671 Mean :0.8568 Mean :0.11306 Mean :1.424
## 3rd Qu.:0.09727 3rd Qu.:0.9986 3rd Qu.:0.12942 3rd Qu.:1.660
## Max. :0.25132 Max. :1.0000 Max. :0.25178 Max. :1.662
## count
## Min. :1151
## 1st Qu.:1262
## Median :1596
## Mean :1875
## 3rd Qu.:1886
## Max. :4872
##
## mining info:
## data ntransactions support confidence
## transacciones 19386 0.05 0.7
## call
## apriori(data = transacciones, parameter = list(supp = 0.05, conf = 0.7, minlen = 2))inspect(head(sort(reglas1, by = "lift"), 10))## lhs rhs support confidence coverage lift count
## [1] {Country_United States of America,
## Drama} => {Lang_en} 0.08882699 1.0000000 0.08882699 1.662037 1722
## [2] {Comedy,
## Country_United States of America} => {Lang_en} 0.09341793 0.9994481 0.09346951 1.661120 1811
## [3] {Action,
## Country_United States of America} => {Lang_en} 0.06251934 0.9991756 0.06257093 1.660667 1212
## [4] {Country_United States of America,
## Thriller} => {Lang_en} 0.06597545 0.9984387 0.06607861 1.659442 1279
## [5] {Country_United States of America} => {Lang_en} 0.25131538 0.9981561 0.25177963 1.658972 4872
## [6] {Thriller} => {Lang_en} 0.13282781 0.7786513 0.17058702 1.294147 2575
## [7] {Family} => {Lang_en} 0.06839988 0.7740806 0.08836274 1.286551 1326
## [8] {Science Fiction} => {Lang_en} 0.06061075 0.7684761 0.07887135 1.277236 1175
## [9] {Horror} => {Lang_en} 0.09259259 0.7631803 0.12132467 1.268434 1795
## [10] {Crime} => {Lang_en} 0.05937274 0.7474026 0.07943877 1.242211 1151Paso 5: Segundo intento (más flexible)
reglas2 <- apriori(transacciones,
parameter = list(supp = 0.02,
conf = 0.6,
minlen = 2))## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.6 0.1 1 none FALSE TRUE 5 0.02 2
## maxlen target ext
## 10 rules TRUE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 387
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[1521 item(s), 19386 transaction(s)] done [0.01s].
## sorting and recoding items ... [29 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 4 done [0.00s].
## writing ... [82 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].summary(reglas2)## set of 82 rules
##
## rule length distribution (lhs + rhs):sizes
## 2 3 4
## 19 46 17
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2.000 3.000 3.000 2.976 3.000 4.000
##
## summary of quality measures:
## support confidence coverage lift
## Min. :0.02012 Min. :0.6143 Min. :0.02094 Min. : 1.021
## 1st Qu.:0.02294 1st Qu.:0.6995 1st Qu.:0.03174 1st Qu.: 1.269
## Median :0.02902 Median :0.7713 Median :0.03722 Median : 1.658
## Mean :0.04169 Mean :0.8158 Mean :0.05199 Mean : 3.516
## 3rd Qu.:0.04343 3rd Qu.:0.9962 3rd Qu.:0.05674 3rd Qu.: 2.517
## Max. :0.25132 Max. :1.0000 Max. :0.25178 Max. :28.627
## count
## Min. : 390.0
## 1st Qu.: 444.8
## Median : 562.5
## Mean : 808.3
## 3rd Qu.: 842.0
## Max. :4872.0
##
## mining info:
## data ntransactions support confidence
## transacciones 19386 0.02 0.6
## call
## apriori(data = transacciones, parameter = list(supp = 0.02, conf = 0.6, minlen = 2))reglas_ordenadas <- sort(reglas2, by = "lift", decreasing = TRUE)
inspect(head(reglas_ordenadas, 15))## lhs rhs support confidence coverage lift count
## [1] {Animation,
## Lang_ja} => {Country_Japan} 0.02285154 0.9022403 0.02532756 28.626565 443
## [2] {Country_Japan} => {Lang_ja} 0.03125967 0.9918167 0.03151759 22.202492 606
## [3] {Lang_ja} => {Country_Japan} 0.03125967 0.6997691 0.04467141 22.202492 606
## [4] {Animation,
## Country_Japan} => {Lang_ja} 0.02285154 0.9910515 0.02305788 22.185362 443
## [5] {Country_FR} => {Lang_fr} 0.02011761 0.9112150 0.02207779 16.146996 390
## [6] {Animation,
## Comedy,
## Lang_en} => {Family} 0.02068503 0.8371608 0.02470855 9.474138 401
## [7] {Animation,
## Country_United States of America,
## Lang_en} => {Family} 0.02537914 0.7639752 0.03321985 8.645897 492
## [8] {Animation,
## Country_United States of America} => {Family} 0.02548231 0.7635240 0.03337460 8.640791 494
## [9] {Animation,
## Comedy} => {Family} 0.02316104 0.7093207 0.03265243 8.027374 449
## [10] {Adventure,
## Animation} => {Family} 0.02218096 0.6574924 0.03373569 7.440833 430
## [11] {Animation,
## Lang_en} => {Family} 0.03739812 0.6496416 0.05756732 7.351986 725
## [12] {Country_Japan} => {Animation} 0.02305788 0.7315876 0.03151759 7.181041 447
## [13] {Country_Japan,
## Lang_ja} => {Animation} 0.02285154 0.7310231 0.03125967 7.175501 443
## [14] {Adventure,
## Family} => {Animation} 0.02218096 0.6231884 0.03559270 6.117028 430
## [15] {,
## Lang_en} => {Country_} 0.03213659 0.6838639 0.04699268 3.424796 623Filtrado de reglas relevantes
reglas_filtradas <- sort(reglas1, by = "lift", decreasing = TRUE)
inspect(head(reglas_filtradas, 10))## lhs rhs support confidence coverage lift count
## [1] {Country_United States of America,
## Drama} => {Lang_en} 0.08882699 1.0000000 0.08882699 1.662037 1722
## [2] {Comedy,
## Country_United States of America} => {Lang_en} 0.09341793 0.9994481 0.09346951 1.661120 1811
## [3] {Action,
## Country_United States of America} => {Lang_en} 0.06251934 0.9991756 0.06257093 1.660667 1212
## [4] {Country_United States of America,
## Thriller} => {Lang_en} 0.06597545 0.9984387 0.06607861 1.659442 1279
## [5] {Country_United States of America} => {Lang_en} 0.25131538 0.9981561 0.25177963 1.658972 4872
## [6] {Thriller} => {Lang_en} 0.13282781 0.7786513 0.17058702 1.294147 2575
## [7] {Family} => {Lang_en} 0.06839988 0.7740806 0.08836274 1.286551 1326
## [8] {Science Fiction} => {Lang_en} 0.06061075 0.7684761 0.07887135 1.277236 1175
## [9] {Horror} => {Lang_en} 0.09259259 0.7631803 0.12132467 1.268434 1795
## [10] {Crime} => {Lang_en} 0.05937274 0.7474026 0.07943877 1.242211 1151Paso 7: Visualización de reglas
plot(reglas_filtradas, method = "graph")
Interpretación de reglas
Los resultados del algoritmo Apriori (soporte mínimo 0.02 y confianza 0.6) muestran que el país de producción es un fuerte predictor del idioma. Por ejemplo, las reglas que combinan Estados Unidos con géneros como Drama, Comedy, Action o Thriller implican casi siempre que la película está en inglés (confianzas ≈ 1 y lift ≈ 1.66). Además, la regla {Country_United States of America} => {Lang_en} tiene el mayor soporte (0.25), indicando que una cuarta parte del total son películas estadounidenses en inglés.
También destacan asociaciones muy fuertes entre Japón y el idioma japonés, con lifts superiores a 22, lo que refleja una relación casi determinística entre país e idioma. Por otro lado, el género Animation aparece frecuentemente vinculado con Family, con lifts entre 7 y 9, mostrando que las películas animadas tienden a orientarse al público familiar. En conjunto, las reglas revelan patrones claros entre país, idioma y ciertos géneros.
Seleccion de Algoritmo de Aprendizaje no supervisado
Se decidio utilizar SVD de todos los modelos ya que la Descomposición en Valores Singulares (SVD) actúa como una potente herramienta de análisis que desglosa cualquier conjunto de datos en sus componentes estructurales más básicos, permitiendo entender la arquitectura interna de la información.
Con esto nosotros buscamos evaluar la importancia de cada conjunto de variables que forman un componente desde una perspectiva teórica, este algoritmo funciona como un filtro que jerarquiza los patrones encontrados, identificando cuáles son las tendencias dominantes y cuáles son simplemente ruido o detalles irrelevantes.
Aprendizaje no supervisado: SVD
Primero preparamos el dataset manteniendo solo las columnas que deseamos evaluar con SVD en la cual limpiamos el dataset quitando los NAs y filtrando valores = 0 ya que estos no aportan informacion clave al modelo.
Por otro lado aplicamos una transformacion logaritmica para que el modelo comprenda mejor los datos matriciales de manera lineal.
movies_train <- movies |>
select(budget, revenue, popularity, voteAvg, voteCount, runtime) |>
filter(budget > 0 & revenue > 0) |>
na.omit()
movies_train_scaled <- scale(movies_train)
movies_train_log <- movies |>
select(budget, revenue, popularity, voteAvg, voteCount, runtime) |>
filter(budget > 0, revenue > 0, voteCount > 0, popularity > 0, runtime > 0) |>
mutate(
budget = log1p(budget),
revenue = log1p(revenue),
popularity = log1p(popularity),
voteCount = log1p(voteCount),
runtime = log1p(runtime)
) |>
na.omit()
movies_train_scaled_log <- scale(movies_train_log)Analisis de PCA y SVD donde definimos la cantidad de datos que captura cada componente, en otras palabras que tantos datos son relevantes para cada componente generado
svd_movies <- svd(movies_train_scaled_log)
var_explained <- svd_movies$d^2 / sum(svd_movies$d^2)
print(var_explained)## [1] 0.50054850 0.19412538 0.13414314 0.08539712 0.05010293 0.03568293print(cumsum(var_explained))## [1] 0.5005485 0.6946739 0.8288170 0.9142141 0.9643171 1.0000000var_df <- data.frame(
componente = factor(paste0("C", 1:length(var_explained)),
levels = paste0("C", 1:length(var_explained))),
varianza = var_explained
)
ggplot(var_df, aes(x = componente, y = varianza)) +
geom_col() +
labs(
title = "Varianza explicada por componente",
x = "Componente",
y = "Proporción de varianza explicada"
) +
theme_minimal()
Cumulative sume o suma acumulada dice cuando se llevan acumulado al sumar los componentes uno por uno. Esta representacion va de la mano con la varianza explicada donde • con 1 componente representa 50% de los datos • con 2 componentes representa 69% • con 3 componentes representa 82% • con 4 componentes representa 90%
cum_var <- cumsum(var_explained)
cum_df <- data.frame(
componente = 1:length(cum_var),
varianza_acumulada = cum_var * 100
)
ggplot(cum_df, aes(x = componente, y = varianza_acumulada)) +
geom_line() +
geom_point() +
geom_hline(yintercept = 80, linetype = "dashed") +
geom_hline(yintercept = 90, linetype = "dashed") +
labs(
title = "Varianza explicada acumulada",
x = "Número de componentes",
y = "Varianza acumulada (%)"
) +
theme_minimal()
El componente 1 representa la escala comercial de las películas, ya que está fuertemente asociado con presupuesto, ingresos, popularidad y cantidad de votos. El componente 2 representa valoración promedio / recepción crítica o del público, está fuertemente relacionado con la calificación promedio (voteAvg), por lo que puede interpretarse como una dimensión de recepción o valoración de la película.
loadings <- as.data.frame(svd_movies$v)
rownames(loadings) <- colnames(movies_train_scaled_log)
print(loadings)## V1 V2 V3 V4 V5 V6
## budget 0.4695905 0.380772191 0.09077956 0.1901123 0.4479443 0.6240670
## revenue 0.5032487 0.096924549 -0.02478156 0.4774133 0.1606733 -0.6949769
## popularity 0.3996284 -0.125541640 -0.56830763 -0.6601311 0.2328810 -0.1074995
## voteAvg 0.0697491 -0.877905511 0.17430532 0.1733521 0.3836390 0.1296333
## voteCount 0.4820718 -0.243168571 -0.19436866 0.1972042 -0.7415819 0.2861178
## runtime 0.3595338 0.002902895 0.77460304 -0.4808536 -0.1489085 -0.1316176para calcular SVD seguimos la siguiente formula var_explained <- d^2 / sum(d^2) Cada cuadrado de los valores singulares representan la variabilidad que aporta cada componente y sum para ver la acumulacion de estos datos.
scores <- as.data.frame(movies_train_scaled_log %*% svd_movies$v)
ggplot(scores, aes(x = V1, y = V2)) +
geom_point(alpha = 0.5) +
labs(
title = "Películas proyectadas en los dos primeros componentes",
x = "Componente 1: escala / éxito comercial",
y = "Componente 2: valoración promedio"
) +
theme_minimal()
Conclusiones y Hallazgos
Hallazgos del SVD y PCA
Los componentes cuentan con los datos distribuidos de manera bastante decente, teniendo: • Componente 1 explica 50% • Componente 2 explica 19% • Componente 3 explica 13% Por lo que podemos concluir que cada dato si representa un valor relevante para la relacion entre valores de las peliculas.
Hallazgos del Clustering
El análisis sobre 4,262 películas reveló 4 grupos naturales, validados por Hopkins cercano a 1.0 y silueta promedio de 0.537 para K-Means.
Cluster 1 — Producciones Convencionales (87% del catálogo): La columna vertebral de la industria. Presupuestos medianos de $20M e ingresos de $44M (ratio ~2.2x). Dominados por Drama, Comedia y Thriller. Segmento altamente competitivo con márgenes moderados.
Cluster 2 — Blockbusters Comerciales (11%): El grupo más rentable, con ratio ingreso/presupuesto de ~4:1 ($540M vs $130M). Producciones de Action y Adventure que generan el mayor retorno absoluto. La silueta baja (0.14) en algunas películas sugiere que la frontera con el Cluster 1 es difusa.
Cluster 3 — Producciones Marginales (2%): Datos financieros casi nulos, probablemente cortometrajes o registros incompletos en TMDB. No aporta valor analítico directo pero es importante identificarlo para no contaminar otros análisis.
Cluster 4 — Fenómenos Virales (7 películas): El hallazgo más sorprendente. Spider-Man: No Way Home (popularidad 8,444), Eternals (11,475) y Sing 2 (6,056) forman un grupo único con popularidad viral masiva desproporcionada respecto a sus cifras financieras, impulsada por su pertenencia a franquicias del MCU y Sony.
Conclusión estratégica para CineVision Studios: La popularidad y el éxito comercial son dimensiones independientes. El Cluster 4 demuestra que pertenecer a franquicias con comunidades de fans activas genera un engagement que supera incluso al de blockbusters de mayor presupuesto. Invertir en propiedad intelectual reconocible y construcción de universos narrativos a largo plazo puede ser tan rentable como competir directamente en presupuesto con los grandes estudios.